home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol099 / usrutil1.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-12-15  |  2.1 KB  |  61 lines
  1. 10  'USRUTIL1.BAS   -  Prints the  RBBS-PC user file in lastname, firstname sequence
  2. 20  ' by Jon Martin       12/28/83.
  3. 30  DEFINT A-Z
  4. 40  DEF FNFL$(A$)=LEFT$(MID$(A$+" , ",INSTR(A$+" , ",", ")+2),INSTR(MID$(A$+", ",INSTR(A$+", ",", ")+3)+"  ","  "))+LEFT$(A$+", ",INSTR(A$+", ",", ")-1)
  5. 50  DEF FNSS$(A$)=LEFT$(A$+"   ",INSTR(A$+"   ","   ")-1)
  6. 60  DEF FNPR$(A$,A%)=LEFT$(A$+SPACE$(A%),A%)
  7. 70  DEF FNCO$(A$)=MID$(A$,1,(INSTR(A$," ")-1))+", "+RIGHT$(A$,(LEN(A$)-INSTR(A$," ")))
  8. 80  KEY OFF
  9. 90  LINE.COUNT=66
  10. 100  CLS
  11. 110  PRINT:PRINT:INPUT"ARE YOU READY TO PROCEED WITH PRINT USER FILE";Y$
  12. 120  IF LEFT$(Y$,1) = "Y" OR LEFT$(Y$,1) = "y" THEN 140
  13. 130  PRINT "PRINT USER FILE RUN ABORTED.":GOTO 520
  14. 140  CLS:PRINT "PRINT USER FILE RUN STARTED AT ";TIME$
  15. 150  OPEN "R",1,"USERS",128:END.USER=LOF(1)/128
  16. 160  OPEN "O",2,"SORT.INP"
  17. 170  FIELD 1,31 AS N$,15 AS PW$,1 AS ST$,14 AS OP$,1 AS SCL$,24 AS CS$,20 AS MA$,14 AS TD$,3 AS LND$,2 AS UDL$,2 AS UUL$
  18. 180  UDX=1
  19. 190  IF UDX > END.USER THEN CLOSE 2:GOTO 300
  20. 200  GET 1,UDX
  21. 210  IF LEFT$(N$,5)=SPACE$(5) THEN 290
  22. 220  NAME.WORK$=FNSS$(N$)
  23. 230  NAME.WORK$=FNCO$(NAME.WORK$)
  24. 240  NAME.WORK$=FNFL$(NAME.WORK$)
  25. 250  NAME.WORK$=FNPR$(NAME.WORK$,31)
  26. 260  NUMBER.WORK$=FNPR$(STR$(UDX),5)
  27. 270  SORT.WORK$=NAME.WORK$+NUMBER.WORK$
  28. 280  PRINT#2,SORT.WORK$
  29. 290  UDX=UDX+1:GOTO 190
  30. 300  'SORT RECORDS
  31. 310  PRINT:PRINT"SORT PHASE STARTED AT ";TIME$
  32. 320  DEF SEG:PEEK.HOLD.ONE=PEEK(&H30):PEEK.HOLD.TWO=PEEK(&H31)
  33. 330  SHELL.HOLD$="SORT <SORT.INP >SORT.OUT":SHELL SHELL.HOLD$
  34. 340  POKE &H30,PEEK.HOLD.ONE:POKE &H31,PEEK.HOLD.TWO
  35. 350  PRINT:PRINT"SORT PHASE ENDED AT   ";TIME$
  36. 360  'FIND USERS
  37. 370  OPEN "I",2,"SORT.OUT"
  38. 380  IF EOF(2) THEN 520
  39. 390  INPUT#2,SORT.WORK$
  40. 400  UDX=VAL(RIGHT$(SORT.WORK$,5))
  41. 410  GET 1,UDX
  42. 420  IF ASC(N$)=0 THEN 380 ELSE A$=RIGHT$("    "+STR$(LOC(1)),5)+":"+LEFT$(SORT.WORK$,31):IF ST$<>"Y"THEN A$=A$+" <Locked out>"
  43. 430  A$=A$+"Pw="+PW$+" Times on="+STR$(CVI(MID$(OP$,1,2)))
  44. 440  GOSUB 560:LPRINT A$
  45. 450  IF SCL$="Y" THEN A$="    (SYSOP)    " ELSE A$="               "
  46. 460  A$=A$+TD$+" "+CS$+MA$
  47. 470  LPRINT A$
  48. 480  A$="      DOWNLOADS="+STR$(CVI(UDL$)):A$=A$+SPACE$(30-LEN(A$))+"UPLOADS="+STR$(CVI(UUL$))
  49. 490  LPRINT A$:LPRINT
  50. 500  LINE.COUNT=LINE.COUNT+4
  51. 510  GOTO 380
  52. 520  'END PROGRAM
  53. 530  PRINT:PRINT "PRINT USER FILE RUN ENDED AT ";TIME$
  54. 540  CLOSE
  55. 550  KILL "SORT.INP":KILL "SORT.OUT":LPRINT CHR$(12):END
  56. 560  IF LINE.COUNT< 60 THEN RETURN
  57. 570  LPRINT CHR$(12)
  58. 580  LPRINT TAB(30);"RBBS-PC SORTED USER LIST"
  59. 590  LPRINT:LPRINT:LINE.COUNT=3
  60. 600  RETURN
  61.